home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
sockets.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-10-06
|
15KB
|
599 lines
/* ******************************************************************** */
/* sockets.c Copyright (C) Codemist and University of Bath 1989 */
/* */
/* Inter-processes communication */
/* ******************************************************************** */
#define PAUSE()
/*
* Change Log:
* Version 1, June 1990
*/
static char *woo_woo = "WOO! WOO!"; /* To appease ncc */
#if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
#include "funcalls.h"
#include "defs.h"
#include "structs.h"
#include "error.h"
#include "global.h"
#include "calls.h"
#include "modboot.h"
#include "allocate.h"
#include "modules.h"
#include "symboot.h"
#include "syssockets.h"
#include "sio.h"
#include "class.h"
/*
* Socket stuff...
*/
/* Globals... */
SYSTEM_GLOBAL(char *,host_machine_name);
SYSTEM_GLOBAL(Host *,host_machine_ref);
SYSTEM_GLOBAL(LispObject,host_machine_lisp_name);
/* classes */
static LispObject Socket;
static LispObject Listener;
/* metaclasses -- maybe use primitive class */
EUFUN_1( Fn_listernerp, obj)
{
return((is_listener(obj) ? lisptrue : nil));
}
EUFUN_CLOSE
EUFUN_1( Fn_socketp, obj)
{
return((is_socket(obj) ? lisptrue : nil));
}
EUFUN_CLOSE
EUFUN_0( Fn_make_listener)
{
LispObject listener;
int length;
int port;
listener = allocate_listener(stacktop);
if ((listener->LISTENER.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
CallError(stacktop,
"make-;istener: unable to make socket",nil,NONCONTINUABLE);
/* Bind it to look for anything... */
listener->LISTENER.name.sin_family = AF_INET;
listener->LISTENER.name.sin_addr.s_addr = INADDR_ANY;
listener->LISTENER.name.sin_port = 0;
length = sizeof(SocketInName);
if (bind(listener->LISTENER.socket,
(SocketName *) &(listener->LISTENER.name),
length) < 0)
CallError(stacktop,"make-listener: can't bind socket",nil,NONCONTINUABLE);
if (getsockname(listener->LISTENER.socket,
(SocketName *) &(listener->LISTENER.name),
&length) < 0)
CallError(stacktop,
"make-listener: can't get socket data",nil,NONCONTINUABLE);
listener->LISTENER.state = SOCKET_VIRGIN;
listen(listener->LISTENER.socket,5); /* One step at a time... */
lval_classof(listener) = Listener;
return(listener);
}
EUFUN_CLOSE
EUFUN_0( Fn_make_socket)
{
LispObject lispsock;
lispsock = allocate_socket(stacktop);
if ((lispsock->SOCKET.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
CallError(stacktop,
"make-socket: unable to make socket",nil,NONCONTINUABLE);
lispsock->SOCKET.state = SOCKET_VIRGIN;
lval_classof(lispsock) = Socket;
return(lispsock);
}
EUFUN_CLOSE
EUFUN_1( Fn_listener_id, sock)
{
LispObject data;
if (!is_listener(sock))
CallError(stacktop,"listener-id: not a listener",sock,NONCONTINUABLE);
if (sock->LISTENER.state != SOCKET_VIRGIN)
CallError(stacktop,"listener-id: socket not virgin ",sock,NONCONTINUABLE);
/* Should lock it for parallel safety I suppose... */
/* Build a list of host machine and port number... */
if (ntohs(sock->LISTENER.name.sin_port) > 0x7ffffff)
CallError(stacktop,
"listener-id: port number overflow!",sock,NONCONTINUABLE);
STACK(sock);
data = (LispObject)
allocate_integer(stacktop,(int) ntohs(sock->LISTENER.name.sin_port));
EUCALLSET_2(data , Fn_cons, SYSTEM_GLOBAL_VALUE(host_machine_lisp_name),
data);
return(data);
}
EUFUN_CLOSE
EUFUN_1( Fn_listen, sock)
{
LispObject new;
int length;
if (!is_listener(sock))
CallError(stacktop,"listen: not a listener",sock,NONCONTINUABLE);
if (sock->LISTENER.state != SOCKET_VIRGIN)
CallError(stacktop,"listen: listener not virgin",sock,NONCONTINUABLE);
/* All is cool... */
sock->LISTENER.state = SOCKET_LISTENING;
sock->LISTENER.state = SOCKET_VIRGIN;
/* Give back a 'copy'... */
new = allocate_socket(stacktop);
lval_classof(new) = Socket;
new->SOCKET.state = SOCKET_CONNECTED;
length = sizeof(SocketInName);
new->SOCKET.socket = accept(sock->SOCKET.socket,
(SocketName *) &(new->SOCKET.name),
&length);
if (new->SOCKET.socket < 0)
CallError(stacktop,"listen: unable to accept connection"
,sock,NONCONTINUABLE);
/* All is cool I think... */
return(new);
}
EUFUN_CLOSE
EUFUN_1( Fn_connect, data)
{
LispObject sock;
LispObject hostname,port;
Host *hostptr;
SocketInName their_name;
if (!is_cons(data))
CallError(stacktop,"connect: invalid socket data",data,NONCONTINUABLE);
hostname = CAR(data); port = CDR(data);
if (!is_symbol(hostname) || !is_fixnum(port))
CallError(stacktop,"connect: invalid data elts",data,NONCONTINUABLE);
/* Hokay... */
STACK_TMP(port);
STACK_TMP(hostname);
sock = allocate_socket(stacktop);
UNSTACK_TMP(hostname);
UNSTACK_TMP(port);
lval_classof(sock) = Socket;
if ((sock->SOCKET.socket = socket(AF_INET,SOCK_STREAM,0)) < 0)
CallError(stacktop,"connect: can't get socket",data,NONCONTINUABLE);
hostptr = gethostbyname(hostname->SYMBOL.pname);
if (hostptr == NULL)
CallError(stacktop,"connect: unknown host",hostname,NONCONTINUABLE);
bcopy((char *) (hostptr->h_addr),
(char *) &(their_name.sin_addr),
hostptr->h_length);
their_name.sin_family = AF_INET;
their_name.sin_port = htons(intval(port));
if (connect(sock->SOCKET.socket,
(SocketName *) &their_name,
sizeof(their_name)) < 0)
CallError(stacktop,"socket-connect: can't connect",data,NONCONTINUABLE);
/* All is cool (hopefully)... */
sock->SOCKET.state = SOCKET_CONNECTED;
return(sock);
}
EUFUN_CLOSE
EUFUN_1( Fn_close_listener, list)
{
if (!is_listener(list))
CallError(stacktop,"close-listener: not a listeners",list,NONCONTINUABLE);
if (list->LISTENER.state != SOCKET_VIRGIN)
CallError(stacktop,"close-listener: not virgin",list,NONCONTINUABLE);
#ifdef notdef
/**/ These lines cause trouble on stardents...
/**/ shutdown(list->LISTENER.socket,2);
/**/
/**/ close(list->LISTENER.socket);
#endif
list->LISTENER.state = SOCKET_CLOSED;
return(nil);
}
EUFUN_CLOSE
EUFUN_1( Fn_close_socket, sock)
{
if (!is_socket(sock))
CallError(stacktop,"close-socket: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_VIRGIN
&& sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,"close-socket: not virgin",sock,NONCONTINUABLE);
shutdown(sock->SOCKET.socket,2);
close(sock->SOCKET.socket);
sock->SOCKET.state = SOCKET_CLOSED;
return(nil);
}
EUFUN_CLOSE
EUFUN_2( Fn_socket_write, sock, form)
{
if (!is_socket(sock))
CallError(stacktop,"socket-write: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,
"socket-write: socket not connected",sock,NONCONTINUABLE);
/* Set up the buffer... */
BUFFER_FORM() = form;
BUFFER_PTR() = 0;
/* Write form... */
write_object(stacktop,form);
*(BUFFER()) = '\0';
/* fprintf(stderr,"written: '%s'\n",BUFFER_START()); */
/* OK, now flush the socket... */
write(sock->SOCKET.socket,(char *) &(BUFFER_PTR()),sizeof(int));
write(sock->SOCKET.socket,BUFFER_START(),BUFFER_PTR());
return(form);
}
EUFUN_CLOSE
#ifdef WITH_SYSTEMV_SOCKETS
#include <stropts.h>
#include <poll.h>
EUFUN_1( Fn_socket_readable_p, sock)
{
struct pollfd fds[1];
unsigned long nfds = 1;
if (!is_socket(sock))
CallError(stacktop,"socket-readable-p: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,"socket-readable-p: not connected",sock,NONCONTINUABLE);
fds[0].fd = sock->SOCKET.socket;
fds[0].events = POLLIN;
fds[0].revents = NULL;
if (poll(fds,nfds,0) < 0)
CallError(stacktop,"socket-readable-p: poll failed",sock,NONCONTINUABLE);
if (fds[0].revents & POLLIN)
return(lisptrue);
else
return(nil);
}
EUFUN_CLOSE
EUFUN_1( Fn_listener_listenable_p, listener)
{
struct pollfd fds[1];
unsigned long nfds = 1;
if (!is_listener(listener))
CallError(stacktop,
"listener_listenable_p: not a listener",listener,NONCONTINUABLE);
fds[0].fd = listener->SOCKET.socket;
fds[0].events = POLLIN;
fds[0].revents = NULL;
if (poll(fds,nfds,0) < 0)
CallError(stacktop,
"socket-readable-p: poll failed",listener,NONCONTINUABLE);
if (fds[0].revents & POLLIN)
return(lisptrue);
else
return(nil);
}
EUFUN_CLOSE
EUFUN_1( Fn_socket_writable_p, sock)
{
struct pollfd fds[1];
unsigned long nfds = 1;
if (!is_socket(sock))
CallError(stacktop,"socket-writable-p: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,"socket-writable-p: not connected",sock,NONCONTINUABLE);
fds[0].fd = sock->SOCKET.socket;
fds[0].events = POLLOUT;
fds[0].revents = NULL;
if (poll(fds,nfds,0) < 0)
CallError(stacktop,"socket-writable-p: poll failed",sock,NONCONTINUABLE);
if (fds[0].revents & POLLOUT)
return(lisptrue);
else
return(nil);
}
EUFUN_CLOSE
#else
/* BSD... */
#include <sys/time.h>
EUFUN_1( Fn_socket_readable_p, sock)
{
fd_set mask;
struct timeval wait;
if (!is_socket(sock))
CallError(stacktop,"socket-readable-p: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,"socket-readable-p: not connected",sock,NONCONTINUABLE);
/* Do a select with 0 timeout... */
wait.tv_sec = 0;
wait.tv_usec = 0;
FD_ZERO(&mask);
FD_SET(sock->SOCKET.socket,&mask);
if (select(getdtablesize(),&mask,NULL,NULL,&wait) < 0)
CallError(stacktop,"socket-readable-p: select failed",sock,NONCONTINUABLE);
if (FD_ISSET(sock->SOCKET.socket,&mask))
return(lisptrue);
else
return(nil);
return(nil);
}
EUFUN_CLOSE
EUFUN_1( Fn_listener_listenable_p, listener)
{
fd_set mask;
struct timeval wait;
if (!is_listener(listener))
CallError(stacktop,
"socket-listenable-p: not a listener",listener,NONCONTINUABLE);
/* Do a select with 0 timeout... */
wait.tv_sec = 0;
wait.tv_usec = 0;
FD_ZERO(&mask);
FD_SET(listener->LISTENER.socket,&mask);
if (select(getdtablesize(),&mask,NULL,NULL,&wait) < 0)
CallError(stacktop,
"socket-readable-p: select failed",listener,NONCONTINUABLE);
if (FD_ISSET(listener->LISTENER.socket,&mask))
return(lisptrue);
else
return(nil);
return(nil);
}
EUFUN_CLOSE
EUFUN_1( Fn_socket_writable_p, sock)
{
fd_set mask;
struct timeval wait;
if (!is_socket(sock))
CallError(stacktop,
"socket-readable-p: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,
"socket-readable-p: not connected",sock,NONCONTINUABLE);
/* Do a select with 0 timeout... */
wait.tv_sec = 0;
wait.tv_usec = 0;
FD_ZERO(&mask);
FD_SET(sock->SOCKET.socket,&mask);
if (select(getdtablesize(),NULL,&mask,NULL,&wait) < 0)
CallError(stacktop,"socket-readable-p: select failed",sock,NONCONTINUABLE);
if (FD_ISSET(sock->SOCKET.socket,&mask))
return(lisptrue);
else
return(nil);
return(nil);
}
EUFUN_CLOSE
#endif
EUFUN_1( Fn_socket_read, sock)
{
int len,ret;
LispObject obj;
if (!is_socket(sock))
CallError(stacktop,"socket-read: not a socket",sock,NONCONTINUABLE);
if (sock->SOCKET.state != SOCKET_CONNECTED)
CallError(stacktop,"socket-read: not connected",sock,NONCONTINUABLE);
#ifdef NOTDEFINED /* Allow this call to block */
if (Fn_socket_readable_p(sock) == nil)
CallError(stacktop,"socket-read: socket unreadable",sock,NONCONTINUABLE);
#endif
/* Get the length... */
if ( (ret = read(sock->SOCKET.socket,(char *) &len,sizeof(int))) == -1)
{
CallError(stacktop,
"socket-read: could not read socket",sock,NONCONTINUABLE);
}
/* Read the data... */
if ((ret = read(sock->SOCKET.socket,(char *) (BUFFER_START()),len)) == -1)
{
CallError(stacktop,
"socket-read: could not complete socket-read",
sock,NONCONTINUABLE);
}
/* fprintf(stderr,"read: '%s'\n",BUFFER_START()); */
*(BUFFER_START() + len) = '\0';
*(BUFFER_START() + len + 1) = '\n';
/* Set up buffer... */
BUFFER_PTR() = 0;
obj = read_object(stacktop);
return(obj);
}
EUFUN_CLOSE
/* *************************************************************** */
/* Initialisation of this section */
/* *************************************************************** */
#define SOCKETS_ENTRIES 15
MODULE Module_sockets;
LispObject Module_sockets_values[SOCKETS_ENTRIES];
void initialise_sockets(LispObject *stacktop)
{
extern LispObject Standard_Class,Object, Primitive_Class;
Socket = (LispObject) allocate_class(stacktop,NULL);
add_root(&Socket);
Listener = (LispObject) allocate_class(stacktop,NULL);
add_root(&Listener);
make_class(stacktop,Listener, "listener",Primitive_Class,Object, 0);
make_class(stacktop,Socket, "socket",Primitive_Class,Object, 0);
SYSTEM_INITIALISE_GLOBAL(char *,host_machine_name,NULL);
SYSTEM_INITIALISE_GLOBAL(Host *,host_machine_ref,NULL);
SYSTEM_INITIALISE_GLOBAL(LispObject,host_machine_lisp_name,NULL);
ADD_SYSTEM_GLOBAL_ROOT(host_machine_lisp_name);
SYSTEM_GLOBAL_VALUE(host_machine_name) = (char *) malloc(64);
gethostname(SYSTEM_GLOBAL_VALUE(host_machine_name),64);
SYSTEM_GLOBAL_VALUE(host_machine_lisp_name)
= (LispObject) get_symbol(stacktop,SYSTEM_GLOBAL_VALUE(host_machine_name));
open_module(stacktop,
&Module_sockets,Module_sockets_values,"sockets",SOCKETS_ENTRIES);
(void) make_module_function(stacktop,"socketp",Fn_socketp,1);
(void) make_module_function(stacktop,"make-listener",
Fn_make_listener,0);
(void) make_module_function(stacktop,"make-socket",
Fn_make_socket,0);
(void) make_module_function(stacktop,"listener-id",Fn_listener_id,1);
(void) make_module_function(stacktop,"listen",Fn_listen,1);
(void) make_module_function(stacktop,"connect",Fn_connect,1);
(void) make_module_function(stacktop,"close-listener",Fn_close_listener,1);
(void) make_module_function(stacktop,"close-socket",Fn_close_socket,1);
(void) make_module_function(stacktop,"socket-write",Fn_socket_write,2);
(void) make_module_function(stacktop,"socket-read",Fn_socket_read,1);
(void) make_module_function(stacktop,"socket-readable-p",Fn_socket_readable_p,1);
(void) make_module_function(stacktop,"socket-writable-p",Fn_socket_writable_p,1);
(void) make_module_function(stacktop,"listener-listenable-p",Fn_listener_listenable_p,1);
(void) make_module_entry(stacktop,"listener",Listener);
(void) make_module_entry(stacktop,"socket",Socket);
close_module();
}
#endif